home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / getinfo.fr_ / getinfo.fr
Text File  |  1995-05-01  |  18KB  |  480 lines
  1. VERSION 4.00
  2. Begin VB.Form frmGetInfo 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Get ODBC Information"
  5.    ClientHeight    =   3945
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1500
  8.    ClientWidth     =   5055
  9.    Height          =   4350
  10.    Left            =   1035
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3945
  13.    ScaleWidth      =   5055
  14.    Top             =   1155
  15.    Width           =   5175
  16.    Begin VB.TextBox txtStatus 
  17.       BackColor       =   &H00C0C0C0&
  18.       Height          =   285
  19.       Left            =   120
  20.       TabIndex        =   5
  21.       Text            =   "Select the options you want to include."
  22.       Top             =   3600
  23.       Width           =   4815
  24.    End
  25.    Begin VB.CommandButton cmdCancel 
  26.       Cancel          =   -1  'True
  27.       Caption         =   "&Cancel"
  28.       Height          =   375
  29.       Left            =   3600
  30.       TabIndex        =   4
  31.       Top             =   2760
  32.       Width           =   1335
  33.    End
  34.    Begin VB.CommandButton cmdGetInfo 
  35.       Caption         =   "&Get Info"
  36.       Height          =   375
  37.       Left            =   3600
  38.       TabIndex        =   3
  39.       Top             =   600
  40.       Width           =   1335
  41.    End
  42.    Begin VB.CommandButton cmdSelection 
  43.       Caption         =   "&Unselect All"
  44.       Height          =   375
  45.       Index           =   1
  46.       Left            =   3600
  47.       TabIndex        =   2
  48.       Top             =   1920
  49.       Width           =   1335
  50.    End
  51.    Begin VB.CommandButton cmdSelection 
  52.       Caption         =   "&Select All"
  53.       Height          =   375
  54.       Index           =   0
  55.       Left            =   3600
  56.       TabIndex        =   1
  57.       Top             =   1440
  58.       Width           =   1335
  59.    End
  60.    Begin VB.ListBox lstGetInfoData 
  61.       Height          =   2955
  62.       Left            =   120
  63.       MultiSelect     =   2  'Extended
  64.       Sorted          =   -1  'True
  65.       TabIndex        =   0
  66.       Top             =   360
  67.       Width           =   3255
  68.    End
  69.    Begin VB.Label Label1 
  70.       AutoSize        =   -1  'True
  71.       BackColor       =   &H00C0C0C0&
  72.       BackStyle       =   0  'Transparent
  73.       Caption         =   "SQLGetInfo Options:"
  74.       Height          =   195
  75.       Left            =   120
  76.       TabIndex        =   6
  77.       Top             =   120
  78.       Width           =   1470
  79.    End
  80. End
  81. Attribute VB_Name = "frmGetInfo"
  82. Attribute VB_Creatable = False
  83. Attribute VB_Exposed = False
  84. Option Explicit
  85.  
  86. 'tell to put in calls to ODBCError after calls to SQLGetInfo if having problems
  87.  
  88.  
  89.  
  90.  
  91.  
  92. Private Sub cmdCancel_Click()
  93.     Unload Me
  94. End Sub
  95.  
  96. Private Sub cmdGetInfo_Click()
  97.     Dim selCount As Integer     'count of selected items
  98.     Dim i As Integer, j As Integer
  99.     
  100.     'Return value types
  101.     Dim ri As Integer
  102.     Dim rs As String * 255
  103.     Dim rb As Long
  104.     Dim rl As Long
  105.  
  106.     Dim rgbInfoValue As Long
  107.     Dim cbInfoValueMax As Integer
  108.     Dim pcbInfoValue As Integer
  109.     Dim result As Integer
  110.     Dim temp As String
  111.     Dim ConnIndex As Integer
  112.     Dim cdID As String
  113.     Dim errMsg As String
  114.     Dim RowData() As String
  115.     
  116.     cbInfoValueMax = 255
  117.     
  118.     'Get the number of rows selected and the type of data
  119.     selCount = 0
  120.     For i = 0 To lstGetInfoData.ListCount - 1
  121.         If lstGetInfoData.Selected(i) Then
  122.             ReDim Preserve RowData(selCount + 1)
  123.             RowData(selCount) = lstGetInfoData.List(i)
  124.             selCount = selCount + 1
  125.         End If
  126.     Next
  127.     
  128.     If selCount = 0 Then
  129.         MsgBox "No attributes were selected. Please select at least one and try again.", MB_ICONEXCLAMATION
  130.         Exit Sub
  131.     End If
  132.     
  133.     'Start by clearing the frmODBC grid
  134.     frmODBC.grdResults.Rows = selCount + 1
  135.     frmODBC.grdResults.Cols = 3
  136.     frmODBC.grdResults.FixedCols = 1
  137.     frmODBC.grdResults.FixedRows = 1
  138.     frmODBC.grdResults.ColWidth(0) = 8
  139.     frmODBC.grdResults.ColWidth(1) = 0.45 * frmODBC.grdResults.Width
  140.     frmODBC.grdResults.ColWidth(2) = 0.55 * frmODBC.grdResults.Width
  141.     frmODBC.grdResults.Row = 0
  142.     frmODBC.grdResults.Col = 1
  143.     frmODBC.grdResults.text = "Attribute Constant"
  144.     frmODBC.grdResults.Col = 2
  145.     frmODBC.grdResults.text = "Value"
  146.     
  147.     frmODBC.lblGrid.Caption = frmODBC.lstODBCdbs.text & " " & "Properties"
  148.     
  149.     For i = 0 To selCount - 1
  150.         frmODBC.grdResults.Row = i + 1
  151.         
  152.         frmODBC.grdResults.Col = 0
  153.         frmODBC.grdResults.text = i + 1
  154.         
  155.         frmODBC.grdResults.Col = 1
  156.         frmODBC.grdResults.text = RowData(i)
  157.         
  158.         frmODBC.grdResults.Col = 2
  159.         
  160.         'Get the index of ODBConn - have to do it this way
  161.         'because there are gaps in the ODBC constants
  162.         For j = 0 To UBound(ODBCGetInfo)
  163.             If RowData(i) = ODBCGetInfo(j).InfoType Then
  164.                 'j now equals the index
  165.                 Exit For
  166.             End If
  167.         Next
  168.         
  169.         'Format the data according the return type of
  170.         'ODBCGetInfo
  171.         Select Case Left$(ODBCGetInfo(j).ReturnType, 1)
  172.             Case "S"    'String
  173.                 result = SQLGetInfo(ghDbc, j, ByVal rs, Len(rs), pcbInfoValue)
  174.                 If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
  175.                     frmODBC.grdResults.text = SpecialStr(RowData(i), Trim$(rs))
  176.                 Else
  177.                     frmODBC.grdResults.text = Trim$(rs)
  178.                 End If
  179.             Case "B"    '32-bit Bitmask
  180.                 result = SQLGetInfo(ghDbc, j, rb, 255, pcbInfoValue)
  181.                 frmODBC.grdResults.text = BitMask(rb)
  182.             Case "I"    'Integer
  183.                 result = SQLGetInfo(ghDbc, j, ri, 255, pcbInfoValue)
  184.                 If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
  185.                     frmODBC.grdResults.text = SpecialInt(RowData(i), Trim$(ri))
  186.                 Else
  187.                     frmODBC.grdResults.text = ri
  188.                 End If
  189.             Case "L"    'Long
  190.                 result = SQLGetInfo(ghDbc, j, rl, 255, pcbInfoValue)
  191.                 If Len(Trim$(ODBCGetInfo(j).ReturnType)) > 1 Then
  192.                     frmODBC.grdResults.text = SpecialLong(RowData(i), Trim$(rl))
  193.                 Else
  194.                     frmODBC.grdResults.text = rl
  195.                 End If
  196.             Case Else
  197.                 'Error in array
  198.                 frmODBC.grdResults.text = "Error processing return value."
  199.         End Select
  200.         If result <> SQL_SUCCESS Then
  201.             frmODBC.grdResults.text = "Error getting data."
  202.         End If
  203.                 
  204.     Next
  205.     frmODBC.grdResults.Visible = True
  206.     Unload Me
  207. End Sub
  208.  
  209. Private Sub cmdSelection_Click(Index As Integer)
  210.     'Select all of the items in the list
  211.     Dim i As Integer
  212.     For i = 0 To lstGetInfoData.ListCount - 1
  213.         lstGetInfoData.Selected(i) = IIf(Index, False, True)
  214.     Next
  215. End Sub
  216.  
  217. Private Sub Form_Load()
  218.     'Load the list box with the ODBCGetInfo array
  219.     Dim i As Integer
  220.     For i = 0 To SQL_INFO_LAST
  221.         If ODBCGetInfo(i).InfoType <> "" Then
  222.             lstGetInfoData.AddItem ODBCGetInfo(i).InfoType
  223.         End If
  224.     Next
  225.     frmGetInfo.Move (Screen.Width - frmGetInfo.Width) / 2, (Screen.Height - frmGetInfo.Height) / 2
  226.     frmGetInfo.Show
  227. End Sub
  228.  
  229. Private Function SpecialStr(Opt As String, RetStr As String)
  230.     'Do any special processing required for a SQLGetInfo string
  231.     Select Case Opt
  232.         Case "SQL_ODBC_SQL_OPT_IEF"
  233.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  234.         Case "SQL_COLUMN_ALIAS"
  235.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  236.         Case "SQL_KEYWORDS"
  237.             SpecialStr = "List of keywords."        '&&&
  238.         Case "SQL_ORDER_BY_COLUMNS_IN_SELECT"
  239.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  240.         Case "SQL_MAX_ROW_SIZE_INCLUDES_LONG"
  241.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  242.         Case "SQL_EXPRESSIONS_IN_ORDERBY"
  243.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  244.         Case "SQL_MULT_RESULT_SETS"
  245.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  246.         Case "SQL_OUTER_JOINS"
  247.             Select Case RetStr
  248.                 Case "N"
  249.                     SpecialStr = "No outer joins."
  250.                 Case "Y"
  251.                     SpecialStr = "Yes, left-right segregation."
  252.                 Case "P"
  253.                     SpecialStr = "Partial outer joins."
  254.                 Case "F"
  255.                     SpecialStr = "Full outer joins."
  256.                 Case Else
  257.                     SpecialStr = "Missing data."
  258.             End Select
  259.         Case "SQL_NEED_LONG_DATA_LEN"
  260.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  261.         Case "SQL_LIKE_ESCAPE_CLAUSE"
  262.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  263.         Case "SQL_ACCESSIBLE_PROCEDURES"
  264.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  265.         Case "SQL_ACCESSIBLE_TABLES"
  266.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  267.         Case "SQL_DATA_SOURCE_READ_ONLY"
  268.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  269.         Case "SQL_PROCEDURES"
  270.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  271.         Case "SQL_ROW_UPDATES"
  272.             SpecialStr = IIf(RetStr = "Y", "Yes", "No")
  273.         Case Else
  274.             SpecialStr = "Missing special processing."
  275.     End Select
  276. End Function
  277. Private Function SpecialInt(Opt As String, RetInt As Integer)
  278.     'Do any special processing required for a SQLGetInfo integer
  279.     Select Case Opt
  280.         Case "SQL_CORRELATION_NAME"
  281.             Select Case RetInt
  282.                 Case SQL_CN_NONE
  283.                     SpecialInt = "Not supported."
  284.                 Case SQL_CN_DIFFERENT
  285.                     SpecialInt = "Supported but names vary."
  286.                 Case SQL_CN_ANY
  287.                     SpecialInt = "Any valid user name."
  288.                 Case Else
  289.                     SpecialInt = "Missing data."
  290.             End Select
  291.         Case "SQL_NON_NULLABLE_COLUMNS"
  292.             Select Case RetInt
  293.                 Case SQL_NNC_NULL
  294.                     SpecialInt = "All columns nullable."
  295.                 Case SQL_NNC_NON_NULL
  296.                     SpecialInt = "May be non-nullable."
  297.                 Case Else
  298.                     SpecialInt = "Missing data."
  299.             End Select
  300.         Case "SQL_FILE_USAGE"
  301.             Select Case RetInt
  302.                 Case SQL_FILE_NOT_SUPPORTED
  303.                     SpecialInt = "Not a single tier driver."
  304.                 Case SQL_FILE_TABLE
  305.                     SpecialInt = "Treats data source as table."
  306.                 Case SQL_FILE_QUALIFIER
  307.                     SpecialInt = "Treats data source as qualifier."
  308.                 Case Else
  309.                     SpecialInt = "Missing data."
  310.             End Select
  311.         Case "SQL_NULL_COLLATION"
  312.             Select Case RetInt
  313.                 Case SQL_NC_END
  314.                     SpecialInt = "NULLs sorted to end."
  315.                 Case SQL_NC_HIGH
  316.                     SpecialInt = "NULLs sorted to high end."
  317.                 Case SQL_NC_LOW
  318.                     SpecialInt = "NULLs sorted to low end."
  319.                 Case SQL_NC_START
  320.                     SpecialInt = "NULLs sorted to start."
  321.                 Case Else
  322.                     SpecialInt = "Missing data."
  323.             End Select
  324.         Case "SQL_GROUP_BY"
  325.             Select Case RetInt
  326.                 Case SQL_GB_NOT_SUPPORTED
  327.                     SpecialInt = "Group By not supported."
  328.                 Case SQL_GB_GROUP_BY_EQUALS_SELECT
  329.                     SpecialInt = "All non-aggregated columns, no others."
  330.                 Case SQL_GB_GROUP_BY_CONTAINS_SELECT
  331.                     SpecialInt = "All non-aggregated columns, some others."
  332.                 Case SQL_GB_NO_RELATION
  333.                     SpecialInt = "Not related to select list."
  334.                 Case Else
  335.                     SpecialInt = "Missing data."
  336.             End Select
  337.         Case "SQL_IDENTIFIER_CASE"
  338.             Select Case RetInt
  339.                 Case SQL_IC_UPPER
  340.                     SpecialInt = "Upper case."
  341.                 Case SQL_IC_LOWER
  342.                     SpecialInt = "Lower case."
  343.                 Case SQL_IC_SENSITIVE
  344.                     SpecialInt = "Case sensitive."
  345.                 Case SQL_IC_MIXED
  346.                     SpecialInt = "Mixed case."
  347.                 Case Else
  348.                     SpecialInt = "Missing data."
  349.             End Select
  350.         Case "SQL_QUOTED_IDENTIFIER_CASE"
  351.             Select Case RetInt
  352.                 Case SQL_IC_UPPER
  353.                     SpecialInt = "Upper case."
  354.                 Case SQL_IC_LOWER
  355.                     SpecialInt = "Lower case."
  356.                 Case SQL_IC_SENSITIVE
  357.                     SpecialInt = "Case sensitive."
  358.                 Case SQL_IC_MIXED
  359.                     SpecialInt = "Mixed case."
  360.                 Case Else
  361.                     SpecialInt = "Missing data."
  362.             End Select
  363.         Case "SQL_ODBC_API_CONFORMANCE"
  364.             Select Case RetInt
  365.                 Case SQL_OAC_NONE
  366.                     SpecialInt = "No conformance."
  367.                 Case SQL_OAC_LEVEL1
  368.                     SpecialInt = "Level 1 supported."
  369.                 Case SQL_OAC_LEVEL2
  370.                     SpecialInt = "Level 2 supported."
  371.                 Case Else
  372.                     SpecialInt = "Missing data."
  373.             End Select
  374.         Case "SQL_CURSOR_COMMIT_BEHAVIOR"
  375.             Select Case RetInt
  376.                 Case SQL_CB_DELETE
  377.                     SpecialInt = "Close and delete statements."
  378.                 Case SQL_CB_CLOSE
  379.                     SpecialInt = "Close cursors."
  380.                 Case SQL_CB_PRESERVE
  381.                     SpecialInt = "Preserve cursors."
  382.                 Case Else
  383.                     SpecialInt = "Missing data."
  384.             End Select
  385.         Case "SQL_CURSOR_ROLLBACK_BEHAVIOR"
  386.             Select Case RetInt
  387.                 Case SQL_CB_DELETE
  388.                     SpecialInt = "Close and delete statements."
  389.                 Case SQL_CB_CLOSE
  390.                     SpecialInt = "Close cursors."
  391.                 Case SQL_CB_PRESERVE
  392.                     SpecialInt = "Preserve cursors."
  393.                 Case Else
  394.                     SpecialInt = "Missing data."
  395.             End Select
  396.         Case "SQL_TXN_CAPABLE"
  397.             Select Case RetInt
  398.                 Case SQL_TC_NONE
  399.                     SpecialInt = "Transactions not supported."
  400.                 Case SQL_TC_DML
  401.                     SpecialInt = "DML statements only, DDL cause error."
  402.                 Case SQL_TC_DDL_COMMIT
  403.                     SpecialInt = "DML statements, DDL commit transaction."
  404.                 Case SQL_TC_DDL_IGNORE
  405.                     SpecialInt = "DML statements, DDL ignored."
  406.                 Case SQL_TC_ALL
  407.                     SpecialInt = "Both DML and DDL statements."
  408.                 Case Else
  409.                     SpecialInt = "Missing data."
  410.             End Select
  411.         Case "SQL_QUALIFIER_LOCATION"
  412.             Select Case RetInt
  413.                 Case SQL_QL_START
  414.                     SpecialInt = "Start of name."
  415.                 Case SQL_QL_END
  416.                     SpecialInt = "End of name."
  417.                 Case Else
  418.                     SpecialInt = "Missing data."
  419.             End Select
  420.         Case "SQL_CONCAT_NULL_BEHAVIOR"
  421.             Select Case RetInt
  422.                 Case SQL_CB_NULL
  423.                     SpecialInt = "Result is NULL valued."
  424.                 Case SQL_CB_NON_NULL
  425.                     SpecialInt = "Result is non-NULL concatenation."
  426.                 Case Else
  427.                     SpecialInt = "Missing data."
  428.             End Select
  429.         Case Else
  430.             SpecialInt = "Missing special integer processing."
  431.     End Select
  432. End Function
  433. Private Function BitMask(RetBit As Long)
  434.     'Do processing required for a SQLGetInfo bit mask return
  435.       Dim i As Long, bin As String
  436.       Const maxpower = 30   ' Maximum number of binary digits supported.
  437.       bin = ""  'Build the desired binary number in this string, bin.
  438.       
  439.       If RetBit > 2 ^ maxpower Then
  440.          BitMask = "Error converting data."
  441.          Exit Function
  442.       End If
  443.  
  444.       ' Negative numbers have "1" in the 32nd left-most digit:
  445.       If RetBit < 0 Then bin = bin + "1" Else bin = bin + "0"
  446.  
  447.       For i = maxpower To 0 Step -1
  448.          If RetBit And (2 ^ i) Then   ' Use the logical "AND" operator.
  449.             bin = bin + "1"
  450.          Else
  451.             bin = bin + "0"
  452.          End If
  453.       Next
  454.       BitMask = bin ' The bin string contains the binary number.
  455. End Function
  456. Private Function SpecialLong(Opt As String, RetInt As Integer)
  457.     'Do any special processing required for a SQLGetInfo long
  458.     Select Case Opt
  459.         Case "SQL_DEFAULT_TXN_ISOLATION"
  460.             Select Case RetInt
  461.                 Case SQL_TXN_READ_UNCOMMITTED
  462.                     SpecialLong = "Dirty reads, nonrepeatable, phantoms."
  463.                 Case SQL_TXN_READ_COMMITTED
  464.                     SpecialLong = "No dirty reads, but nonrepeatable and phantoms."
  465.                 Case SQL_TXN_REPEATABLE_READ
  466.                     SpecialLong = "No dirty or nonrepeatable reads. Phantoms okay."
  467.                 Case SQL_TXN_SERIALIZABLE
  468.                     SpecialLong = "Serializable transactions."
  469.                 Case SQL_TXN_VERSIONING
  470.                     SpecialLong = "Serializable transactions with higher concurrency."
  471.                 Case Else
  472.                     SpecialLong = "Missing data."
  473.             End Select
  474.               
  475.         Case Else
  476.             SpecialLong = "Missing special Long processing."
  477.     End Select
  478. End Function
  479.  
  480.